\ This module implements a number of words that we need only at compile time,
\ or only in the Mops development environment.


\		======== Display of source code ========

\ The display is rather crude, but at least you can see the source.
\ If AppleEvents are available, we do a lot better and send an AE to
\ Quick Edit to open the file at the given position, and then we don't
\ use the display code here.  (And good riddance, too.)

false	value	LOG_THERE?
false	value	SRC_THERE?
false	value	USE_MOD?
false	value	QE?

:class  FSSpec  super{ object }
record
{	int		vRefNum
	var		parID
64	bytes	filename
}

:m getVref:		get: vRefNum	;m
:m getDirID:	get: parID		;m

:m setVref:		put: vRefNum	;m
:m setDirID:	put: parID		;m
:m name:		64 min  addr: fileName  >str255  drop  ;m
:m getName:		addr: fileName  count  ;m


:m NEW:
	word0
	int: vRefNum  get: parID  addr: filename  ^base
	call FSMakeFSSpec  i->l  ;m

;class


FSSpec  FS

objPtr	THEMOD  class_is module

window	DW

file	LOG
file	SRC
file	QEF

string+	DSP
string+	S
string+	$TMP
string+	$LOG
string+	$PRF

0	value	CURS_POS
0	value	CURS_ROW
0	value	CURS_COL

0	value	MK_CFA
0	value	TOPDIR
0	value	TOPDATE


: OPEN_SRC_WINDOW
	QE?  ?EXIT				\ If we're showing the source in QE, out
	s copyto: dsp
	2 38  494 170  put: tempRect
	tempRect  " "
	docWind  true true  new: dw
	screenbits true setGrow: dw
	setFwind
	true -> src_there?  ;
	

: SET_DSP  { \ cr? -- }
	true -> cr?
	s  copyto: dsp
	curs_pos >pos: dsp
	2 0 DO  <nextline?: dsp  NIF  LEAVE  THEN  LOOP
	pos: dsp
	10 0 ?DO
		nextline?: dsp  NIF  false -> cr?  LEAVE  THEN
	LOOP
	>pos: dsp
	cr? more: dsp  ;


local DISPLAY  { disp? \ redraw? end_disp curs_line_pos 1st? -- }

: (DISP)
	0 -> curs_row  0 -> curs_line_pos  true -> 1st?
	disp? IF  4 tFont  9 tSize  -curs  cls  THEN		\ Monaco 9
	BEGIN
		nextline?: dsp  0EXIT
		lim: dsp  end_disp  > ?EXIT
		1st? IF  false -> 1st?  ELSE  disp? IF cr THEN  THEN
		lim: dsp  curs_pos  <
		IF  1 ++> curs_row  lim: dsp 1+  -> curs_line_pos  THEN
		disp? IF  get: dsp  type  THEN
	AGAIN  ;

: SHOW_CURS
	+curs  disp? NIF  .cur  THEN		\ If just updating, erase curs
	curs_pos curs_line_pos -  dup -> curs_col 1+  6 *	\ x
	curs_row 1+ #lead *  6 +				\ y
	gotoxy  .cur  ;

: (DISPLAY)
	lim: dsp  -> end_disp
	save: dsp  0 >len: dsp
	(disp)
	restore: dsp  ;


:loc DISPLAY 		 \	{ disp? \ redraw? end_disp curs_line_pos 1st? -- }

	QE?
	IF	qef  curs_pos dup   openFile: tQE  0EXIT
		false -> QE?			\ failed - assume QE has gone away
		open_src_window
	THEN
	src_there?  0EXIT
	pushPort  set: dw
	(display)
	curs_row 0=  pos: dsp  0<>  and  -> redraw?
	curs_row 6 >  lim: dsp  size: dsp  <  and  --> redraw?
	redraw? IF  set_dsp  update: dw  THEN
	show_curs
	popPort  ;loc

' redraw  setdraw: dw		\ Note: this must refer to the EXPORTED
							\ version of redraw.

: REDRAW	true  display  ;
: UPD		false display  ;

: 1UP
	curs_pos 1-  0 max  dup >pos: s >lim: s
	<nextline?: s  0EXIT
	pos: s  dup IF  1+  THEN  -> curs_pos  upd  ;

: 1DN
	curs_pos dup >pos: s >lim: s
	nextline?: s  0EXIT
	lim: s 1+  -> curs_pos  upd  ;

: 1LFT	;	\ Really not much point in implementing these!
: 1RT   ;

: HOMEx		0	-> curs_pos  upd  ;
: END		size: s	-> curs_pos  upd  ;

: DEFNUP  { \ posn -- }
	curs_pos 1-  0 max  dup  >pos: s  >lim: s
	BEGIN
		<nextline?: s  0EXIT
		pos: s  -> posn  posn IF  1 ++> posn  THEN
		ptr: s  posn +  c@  & :  =
		IF  posn -> curs_pos  upd  EXIT  THEN
	AGAIN  ;

: DEFNDN
	curs_pos  dup  >pos: s  >lim: s
	BEGIN
		nextline?: s  0EXIT
		^1st: s  1+  c@  & :  =
		IF  pos: s  1+  -> curs_pos  upd  EXIT  THEN
	AGAIN  ;


\ ADDR>CURS is exported.  It takes a dictionary address, and tries to
\ convert it to the corresponding "cursor" position in the source file.
\ If we have a source window open, it updates the cursor position in
\ that window as well.

: ADDR>CURS  { addr \ offs -- curs-pos }
	log_there?  NIF  0  EXIT  THEN
	addr filestart_dp -  -> addr   0 -> offs
	reset: $log
	BEGIN
		len: $log  0<=  IF  0  EXIT  THEN
		^1st: $log  w@  addr >
		IF  ( found )
			offs -> curs_pos  upd   offs  EXIT
		THEN
		^1st: $log  2+  @  -> offs
		6 skip: $log
	AGAIN  ;


: MOVE_CURS		\ ( pos -- )	Exported.
	-> curs_pos  upd  ;


: SELECTDW			\ Exported.
	src_there?  0EXIT
	select: dw  ;


: CHK_DATE
	getFileInfo: src  OK?  src 76 + @
	use_mod?
	IF
		base: theMod  @
	ELSE
		mk_cfa 6 + @  ?dup NIF -1 THEN
	THEN
	u>
	IF
		3 beep  cr  msg# 76	\ "Source later than compiled version"
	THEN  ;


\ ?OPEN_IN_QE is exported.  It sees if the passed-in file can be opened
\ in Quick Edit via an AppleEvent.  The value QE? is left indicating
\ the result.  It's not a serious problem if we can't find the file, but
\ it's nice if we can.

: ?OPEN_IN_QE  { ^file -- }
	false -> QE?
	AppleEvents?  0EXIT
	getname: [ ^file ]  name: FS
	0 setVref: FS  0 setDirID: FS
	new: FS
	IF		\ An error occured.  The file might have been opened via
			\  standard file.  In this case, topDir will be set.  Let's
			\  try...
		getName: [ ^file ]
		name: FS
		0 setVref: FS  topDir setDirID: FS
		new: fs   ?EXIT			\ Out if we still can't find it
	THEN
	
	getName: FS  name: qef
	getVref: FS  setVref: qef
	getDirID: FS  setDirID: qef
	qef 0 0   openFile: tQE	?EXIT
						\ If AE send failed, maybe QE isn't there at all!
	true -> QE?  ;
		

: (OPEN_SRC)
	2dup  put: $tmp  name: src
	use_mod?
	NIF
		mk_cfa @  setDirID: src
	THEN
	openReadOnly: src  ?EXIT  	\ Out on error
	chk_date
	src  readAll: s				\ read source - we do this even if we can
	close: src drop				\  open it in QE, since we might need it for
								\  PROFILE or something
	src ?open_in_QE
	QE?  ?EXIT
	open_src_window
	get: $tmp  title: dw
	0 -> curs_pos  set_dsp  update: dw  ;


: SRC_NAME
	mk_cfa >name n>count 1-  ;

: OPEN_SRC
	src_name  (open_src)  ;

: OPEN_SRC_IN_MOD
	txtName: theMod  (open_src)  ;


\ The following words are used in conjunction with Quick Edit.

\ EDIT is exported.  It opens the given file in QE if possible.
\ Usage:  edit xxxx

: EDIT
	setName: src
	openReadOnly: src  		\ Get full pathname.
	?error 66				\ "couldn't find source file"
	src ?open_in_QE
	close: src  drop
	QE? not  ?error 67		\ "Quick Edit not open or sys7 not running"
;

\ OPENSOURCE is exported.  This word is called from QE, so we can assume
\ QE is there.  QE is asking us to identify the source file for the given
\ word, and then call QE back to open that file.  The format of the string
\ sent from QE (located in QEstr) is  FindSource xxxxx.  At this point
\ we're EVALUATEing, and have parsed the FindSource, so we can now
\ simply call DEFINED?.
\ Note: this word is also called LOCATE, which I now think is a better name.

: OPENSOURCE
	defined?
	IF	locate_src
	ELSE
		1 beep
		reset: QEstr
		11 skip: QEstr  	\ skip over OpenSource 
		get: QEstr type space  ." not defined!!"
	THEN  ;


\ def?? is exported.  It's needed by the QE special menu item def??

: def?? \ 19Dec93 DBH slightly changed to show us the word in question and
		\  display the answer
	reset: QEstr
	6 skip: QEstr  \ skip over def?? 
	get: QEstr type space
	defined?
	nip
	IF		." defined"
	ELSE	." not defined!!"
	THEN ;


\		========== end of QE-related words =============


: (CREATE_LOG)
	here -> filestart_dp
	new: $lg1  new: $lg2
	$ B3010000 pad !	\ Unique marker for log files | version
	false -> relocChk?
	here pad 4+ reloc!
	true -> relocChk?
	pad 8  put: $lg1  ;


: (WRITE_LOG)		\ Called to write out the log and profile strings to the
			\  2 corresponding files
	getname: topfile  put: $tmp
	" .log"  add: $tmp
	all: $tmp  name: log
	use_mod?  IF  0  ELSE  topDir  THEN
	setDirID: log
		\ OK to use zero for modules, since the module's source
		\ file name will be fully qualified.
	create: log  ?dup
	IF  . space ." I/O err creating log file " abort  THEN
	0 setDirID: log
	'type SLOG  'type Mops  set: log
	reset: $lg1  len: $lg1  ^1st: $lg1 2+  w!
	all: $lg1  write: log  OK?
	all: $lg2  write: log  OK?
	close: log  OK?
	release: $lg1  release: $lg2  ;


: OPEN_LOG			\ Exported (for error handling)
	false -> log_there?
	clear: $log  clear: $prf
	use_mod?
	IF
		" .txt.log" extname: theMod  put: $tmp
		all: $tmp  name: log
\		base: theMod 4+ @  setDirID: log
	ELSE
		mk_cfa 4+  w@
		NIF  ( No log file )
			clear: $log  EXIT
		THEN
		" .log" add: $tmp
		all: $tmp  name: log  0 setVref: log
		mk_cfa @  setDirID: log
	THEN
	openReadOnly: log  ?EXIT		\ If error, maybe log not there.
	pad 8 read: log  OK?
	pad w@  $ B301 =  0EXIT			\ Out if not valid log file
	true -> log_there?
	use_mod?
	IF
		base: theMod
		#imp: theMod  2* +  8 +
	ELSE
		pad 4+ @abs
	THEN
	-> filestart_dp
	log  pad 2+ w@ 8 -  readN: $log
	log  readRest: $prf  close: log  drop
\	rd: $log  rd: $prf
\	set: fwind  dump: $log  set: dw		\ debugging only
	src_there? IF  redraw  THEN
	true -> log_there?  ;


: CL		\ Close src and log etc.
	src_there?  0EXIT
	close: dw  release: s  release: $tmp  release: $log  release: $prf
	close: src drop
	false -> log_there?  false -> src_there?  false -> QE?
	setFwind
	drop: extrasmod  ;


: (FINDMK)		\ ( cfa 0 -- )
	drop  dup -> mk_cfa  2- w@x file-mark = -> endTrav?  ;
	
: FIND_MARK?	\ ( start-addr -- )
	['] (findmk)  0  rot  trav-from
	endTrav?  ;


: LOCATE_SRC  { theCfa -- }		\ Exported.  Opens source window for given
								\ definition, if possible.
	lock: extrasmod		\ Since we have a window, and windows
						\ mustn't move!
	use_mod?
	NIF	theCfa find_mark?
		NIF
			src_there?  IF  cl  THEN  EXIT
		THEN
	THEN
	use_mod?
	IF	open_src_in_mod  open_log
		false -> use_mod?	\ For next time
	ELSE
		open_src  open_log
	THEN
	QE? IF  theCfa >name n>count  find: tQE  drop  THEN  ;


: USE_MODULE	\ ( ^mod -- )
	-> theMod  true -> use_mod?  ;

: PROF_STR	\ Exported - called by DebugMod to get hold of the profile
			\  string and source string.
	reset: $prf  reset: s
	$prf  s  ;


\			======== Code for loading and reloading =========

: PURGE_INIT_ACTIONS  { \ index -- }
			\ We call this before reloading, to get rid of any
			\ invalid entries out of INIT_ACTIONS.
	0 -> index
	BEGIN
		index  size: init_actions  >=  ?EXIT
		index  ^elem: init_actions  @abs  here u>
		IF	index  remove: init_actions
		ELSE	1 ++> index
		THEN
	AGAIN  ;


: <CS  { addr len c \ offs -- addr len offs }
	len -> offs
	addr  addr len + 1-  DO
		i c@  c = IF  LEAVE  THEN
		-1 ++> offs
	-1 +LOOP
	addr len offs  ;


: +LOG		true  -> log?  ;
: -LOG		false -> log?  ;


\ SAVE-LOAD is a smarter variant of mark_file which we use
\  to put a file mark in the dic at the start of each load.
\ It includes the dirID, whether logged, and the date/time
\  loaded.

: SAVE-LOAD
	getName: topFile  put: $tmp  bl +: $tmp  reset: $tmp
	& :  <chsearch: $tmp  negate skip: $tmp
	get: $tmp
	
	crossed?
	IF	ppc_sHdr
		file-mark codeW,			\ file-mark is the "handler code"
		topDir code,
		log? codeW,
		topDate code,
	ELSE
		sHdr  file-mark w,
		topDir ,  log? w,  topDate ,
	THEN
	release: $tmp  ;


: LOADIT  { \ svCurs -- }
\	watchcurs		- now inappropriate with TEFwind
	purge_init_actions
	curs -> svCurs -curs
	getFileInfo: topFile  NIF  topFile 76 + @  ELSE  0  THEN  -> topDate
	clear: topFile
	topDir  setDirID: topFile
	save-load
	MBcomp LdFromMod  drop: loadFile
\	log?  IF  -log  THEN
	svCurs -> curs
\	arrowcurs
;


: L         \ Load
	pushNew: loadfile
	'type TEXT 1 stdget: topfile
	IF	getDirID  dup  setDirID: topFile  -> topDir
		loadit
	ELSE
		clear: loadfile
	THEN  ;  

: FM		\ Forget to mark
	here find_mark?  not abort" No mark!"
	mk_cfa >link (forget)  ;

: RL
	here find_mark?  not abort" L not done!"
	cl		\ Close source window if open as it probably
			\ won't be valid any more.
	pushnew: loadfile
	src_name  name: topFile
	mk_cfa @  dup  -> topDir  setDirID: topFile
\	mk_cfa 4+ w@x  ++> log?
	mk_cfa >link (forget)  loadit  ;



\ Put NEED xxx or " xxx" INCLUDED  at any point where the file of name
\ xxx is to be already loaded.  If it hasn't already been loaded, it
\ is loaded at that point.

\ Note that only one blank or tab is allowed between NEED and the ilename.
\ This is because we use WORD" to read the filename, so that names with
\ embedded blanks are allowed.

: INCLUDED  { \ svLog svTopDir svTopDate -- }
	put: $tmp  bl +: $tmp  reset: $tmp
	& :  <chsearch: $tmp  negate skip: $tmp
	get: $tmp  sFind  nip
	IF  release: $tmp  EXIT  THEN	\ Found - nothing else to do
	
									\ Not found - load it
	latest name> 2- w@x  file-mark =
	IF				\ That was a file-mark - forget it so RL
					\  won't make us reload NEEDed files
		latest n>link (forget)
	THEN
	pushnew: loadFile  get: $tmp  1-  name: topfile
	release: $tmp
	log? -> svLog
	-log							\ Don't log NEEDed file
	openReadOnly: topFile  ?file_open_error
	close: topFile  drop
	getFileInfo: topFile  ?file_open_error
	topDate -> svTopDate
	topDir -> svTopDir
\	getDirID: topFile  -> topDir	\ I'm not too sure why this doesn't work
	0 -> topDir
	clear: topFile					\ Leaves name field intact
	loadit							\ Load NEEDed file
	svLog IF  +log  THEN
	svTopDate -> topDate
	svTopDir  -> topDir
	size: loadFile IF  save-load  THEN
;

: NEED  ( --<filename> )
	word"  count				\ Get name from input
	included  ;


' cl  setrelease